home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
allswags.zip
/
ARCHIVES.SWG
< prev
next >
Wrap
Text File
|
1993-05-29
|
68KB
|
1 lines
SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00012 ARCHIVE HANDLING 1 05-28-9313:33ALL SWAG SUPPORT TEAM Get Archive ID IMPORT 19 {π > I'm looking For descriptions of the formats of headers inπ > all popular archive Files, ie .ZIP, .ARC, .LZH, .ARJ, etc.π > I just want to be able to read the headers of all of theseπ > archives, not necessarily manipulate them. Anyone knowπ > where such can be had?ππHere's a Program that will determine most of the major archive Types.πI've made a couple of additions, but the original source was fromπa message on this echo...the original author's name has since beenπlost. To use the Procedure, just call it as follows:π If GetArcType(FileName.Ext)=Zip then....π}ππUsesπ Dos;ππTypeπ ArcType = (FileError, Unknown, Zip, Zoo, Arc, Lzh, Pak, Arj);ππFunction GetArcType(FName : String) : ArcType;πVarπ ArcFile : File of Byte;π i : Integer;π Gat : ArcType;π c : Array[1..5] of Byte;πbeginπ Assign(ArcFile, FName);π {$I-}π Reset(ArcFile);π {$I+}π if IOResult <> 0 thenπ Gat := FileErrorπ elseπ if FileSize(ArcFile) < 5 thenπ Gat := FileErrorπ elseπ beginπ For i := 1 to 5 doπ Read(ArcFile, c[i]);π Close(ArcFile);π if ((c[1] = $50) and (c[2] = $4B)) thenπ Gat := Zipπ elseπ if ((c[1] = $60) and (c[2] = $EA)) thenπ Gat := Arjπ elseπ if ((c[4] = $6c) and (c[5] = $68)) thenπ Gat := Lzhπ elseπ if ((c[1] = $5a) and (c[2] = $4f) and (c[3] = $4f)) thenπ Gat := Zooπ elseπ if ((c[1] = $1a) and (c[2] = $08)) thenπ Gat := Arcπ elseπ if ((c[1] = $1a) and (c[2] = $0b)) thenπ Gat := Pakπ elseπ Gat := Unknown;π end;ππ GetArcType := Gat;πend;ππVarπ FileName : String;π Return : ArcType;π {ArcType = (FileError,Unknown,Zip,Zoo,Arc,Lzh,Pak,Arj)}πππbeginπ if ParamCount = 1 thenπ beginπ FileName := ParamStr(1);π Return := GetArcType(FileName);π Case Return ofπ ARJ : Writeln(FileName, ' = ARJ ');π PAK : Writeln(FileName, ' = PAK ');π LZH : Writeln(FileName, ' = LZH ');π ARC : Writeln(FileName, ' = ARC ');π ZOO : Writeln(FileName, ' = ZOO ');π ZIP : Writeln(FileName, ' = ZIP ');π UNKNOWN : Writeln(FileName, ' = Unknown!')π elseπ Writeln('File Not Found');π end;π end {IF}π elseπ Writeln('No parameter');πend.π 2 05-28-9313:33ALL SWAG SUPPORT TEAM Display Archive Files IMPORT 73 {π Hmmmm, I thought I responded to you on this before. Whether I did orπnot, I will post what I did before (in the next two messages), but Iπdon't want to post the entire Program - I'm building a ShareWareπprogream I plan to market, and I don't think I should give it _all_πaway. The code I post is pertinent to reading the headers and Filenameπinfo in the Various archive Types, and I Really think you can work outπthe rest without much trouble. If you can't, please post a specificπquestion...π}ππConstπ BSize = 4096; { I/O Buffer Size }π HMax = 512; { Header Maximum Size }πVarπ I,J,K : Integer;π CT,RC,TC : Integer;π RES : Word; { Buffer Residue }π N,P,Q : LongInt;π C : LongInt; { Buffer Offset }π FSize : LongInt; { File Size }π DEVICE : Char; { Disk Device }π F : File;π SNAME : String;π DATE : String[8]; { formatted date as YY/MM/DD }π TIME : String[5]; { " time as HH:MM }π DirInfo : SearchRec; { File name search Type }π SR : SearchRec; { File name search Type }π DT : DateTime;π PATH : PathStr;π DIR : DirStr;π FNAME : NameStr;π EXT : ExtStr;π Regs : Registers;π BUFF : Array[1..BSize] of Byte;ππProcedure FDT (LI : LongInt); { Format Date/Time fields }πbeginπ UnPackTime (LI,DT);π DATE := FSI(DT.Month,2)+'/'+FSI(DT.Day,2)+'/'+Copy(FSI(DT.Year,4),3,2);π if DATE[4] = ' ' then DATE[4] := '0';π if DATE[7] = ' ' then DATE[7] := '0';π TIME := FSI(DT.Hour,2)+':'+FSI(DT.Min,2);π if TIME[4] = ' ' then TIME[4] := '0';πend; { FDT }ππProcedure MY_FFF;πVar I,J,K : LongInt;ππ(**************************** ARJ Files Processing ***************************)πType ARJHead = Recordπ FHeadSize : Byte;π ArcVer1,π ArcVer2 : Byte;π HostOS,π ARJFlags,π Method : Byte; { MethodType = (Stored, LZMost, LZFast); }π R1,R2 : Byte;π Dos_DT : LongInt;π CompSize,π UCompSize,π CRC : LongInt;π ENP, FM,π HostData : Word;π end;πVar ARJ1 : ARJHead;π ARJId : Word; { 60000, if ARJ File }π HSize : Word; { Header Size }πProcedure GET_ARJ_ENTRY;πbeginπ FillChar(ARJ1,SizeOf(ARJHead),#0); FillChar(BUFF,BSize,#0);π Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES); { read header into buffer }π Move (BUFF[1],ARJId,2); Move (BUFF[3],HSize,2);π if HSize > 0 thenπ With ARJ1 doπ beginπ Move (BUFF[5],ARJ1,SizeOf(ARJHead));π I := FHeadSize+5; SNAME := B40;π While BUFF[I] > 0 do Inc (I);π I := I-FHeadSize-5;π Move (BUFF[FHeadSize+5],SNAME[1],I); SNAME[0] := Chr(I);π FSize := CompSize; Inc (C,HSIZE);π end;πend; { GET_ARJ_ENTRY }ππProcedure DO_ARJ (FN : String);πbeginπ Assign (F,FN); Reset (F,1); C := 1;π GET_ARJ_ENTRY; { Process FileπHeader }π Repeatπ Inc(C,FSize+10);π GET_ARJ_ENTRY;π if HSize > 0 thenπ beginπ Inc (WPX); New(SW[WPX]); { store Filename info in dynamic Array }π With SW[WPX]^ doπ beginπ FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+' ',1,4)π SIZE := ARJ1.UCompSize;π RType := 4; D_T := ARJ1.Dos_DT; ANUM := ADX; VNUM := VDX;π ADD_CNAME;π end;π Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)π end;π Until HSize <= 0;π Close (F);πend; { DO_ARJ }ππ(**************************** ZIP Files Processing ***************************)πType ZIPHead = Recordπ ExtVer : Word;π Flags : Word;π Method : Word;π Fill1 : Word;π Dos_DT : LongInt;π CRC32 : LongInt;π CompSize : LongInt;π UCompSize : LongInt;π FileNameLen : Word;π ExtraFieldLen : Word;π end;πVar ZIPCSize : LongInt;π ZIPId : Word;π ZIP1 : ZIPHead;πProcedure GET_ZIP_ENTRY;πbeginπ FillChar(ZIP1,SizeOf(ZIPHead),#0); Move (BUFF[C+1],ZIPId,2);π if ZIPId > 0 thenπ beginπ Move (BUFF[C+1],ZIP1,SizeOf(ZIPHead));π Inc (C,43); SNAME := '';π With ZIP1 doπ beginπ Move (BUFF[C],SNAME[1],FileNameLen); SNAME[0] := Chr(FileNameLen);π FSize := CompSize;π end;π end;πend; { GET_ZIP_ENTRY }ππProcedure DO_ZIP (FN : String);πConst CFHS : String[4] = 'PK'#01#02; { CENTRAL_File_HEADER_SIGNATURE }π ECDS : String[4] = 'PK'#05#06; { end_CENTRAL_DIRECTORY_SIGNATURE }πVar S4 : String[4];π FOUND : Boolean;π QUIT : Boolean; { "end" sentinel encountered }πbeginπ--- GOMail v1.1 [DEMO] 03-09-93π * Origin: The Private Reserve - Phoenix, AZ (602) 997-9323 (1:114/151)π<<<>>>πππDate: 03-23-93 (22:30) Number: 16806 of 16859 (Echo)π To: EDDIE BRAITER Refer#: NONEπFrom: MIKE COPELAND Read: NOπSubj: FORMAT VIEWER - PART 2 of Status: PUBLIC MESSAGEπConf: F-PASCAL (1221) Read Type: GENERAL (+)ππ(**************************** ARC Files Processing ***************************)πType ARCHead = Recordπ ARCMark : Char;π ARCVer : Byte;π FN : Array[1..13] of Char;π CompSize : LongInt;π Dos_DT : LongInt;π CRC : Word;π UCompSize : LongInt;π end;πConst ARCFlag : Char = #26; { ARC mark }πVar WLV : LongInt; { Working LongInt Variable }π ARC1 : ARCHead;π QUIT : Boolean; { "end" sentinel encountered }ππProcedure GET_ARC_ENTRY;πbeginπ FillChar(ARC1,SizeOf(ARCHead),#0); L := SizeOf(ARCHead);π Seek (F,C); BlockRead (F,BUFF,L,RES);π Move (BUFF[1],ARC1,L);π With ARC1 doπ if (ARCMark = ARCFlag) and (ARCVer > 0) thenπ beginπ SNAME := ''; I := 1;π While FN[I] <> #0 doπ beginπ SNAME := SNAME+FN[I]; Inc(I)π end;π WLV := (Dos_DT Shr 16)+(Dos_DT Shl 16); { flip Date/Time }π FSize := CompSize;π end;π QUIT := ARC1.ARCVer <= 0;πend; { GET_ARC_ENTRY }ππProcedure DO_ARC (FN : String);πbeginπ Assign (F,FN); Reset (F,1); C := 0;π Repeatπ GET_ARC_ENTRY;π if not QUIT thenπ beginπ Inc (WPX); New(SW[WPX]); { store Filename info in dynamic Array }π With SW[WPX]^ doπ beginπ FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+' ',1,4)π SIZE := ARC1.UCompSize; RType := 4; { comp File }π D_T := WLV; ANUM := ADX; VNUM := VDX;π ADD_CNAME;π end;π Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)π end;π Inc (C,FSize+SizeOf(ARCHead))π Until QUIT;π Close (F);πend; { DO_ARC }ππ(************************* LZH Files Processing ******************************)πType LZHHead = Recordπ HSize : Byte;π Fill1 : Byte;π Method : Array[1..5] of Char;π CompSize : LongInt;π UCompSize : LongInt;π Dos_DT : LongInt;π Fill2 : Word;π FileNameLen : Byte;π FileName : Array[1..12] of Char;π end;ππVar LZH1 : LZHHead;ππProcedure GET_LZH_ENTRY;πbeginπ FillChar(LZH1,SizeOf(LZHHead),#0); FillChar (DT,SizeOf(DT),#0);π L := SizeOf(LZHHead);π Seek (F,C); BlockRead (F,BUFF,L,RES);π Move (BUFF[1],LZH1,L);π With LZH1 doπ if HSize > 0 thenπ beginπ Move (FileNameLen,SNAME,FileNameLen+1);π UnPackTime (Dos_DT,DT);π FSize := CompSize;π endπ else QUIT := Trueπend; { GET_LZH_ENTRY }ππProcedure DO_LZH (FN : String);πbeginπ Assign (F,FN); Reset (F,1);π FSize := FileSize(F); C := 0; QUIT := False;π Repeatπ GET_LZH_ENTRY;π if not QUIT thenπ beginπ Inc (WPX); New(SW[WPX]); { store Filename info in dynamic Array }π With SW[WPX]^ doπ beginπ FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+' ',1,4)π SIZE := LZH1.UCompSize;π RType := 4; ANUM := ADX; VNUM := VDX; D_T := LZH1.Dos_DT;π ADD_CNAME;π end;π Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)π end;π Inc (C,FSize+LZH1.HSize+2)π Until QUIT;π Close (F);πend; { DO_LZH }π 3 05-28-9313:33ALL SWAG SUPPORT TEAM String Compression IMPORT 22 {You won't get that sort of compression from my routines, but hereπthey are anyway. When testing, you'll get best compression if youπuse English and longish Strings.π}πUnit Compress;ππInterfaceππConstπ CompressedStringArraySize = 500; { err on the side of generosity }ππTypeπ tCompressedStringArray = Array[1..CompressedStringArraySize] of Byte;ππFunction GetCompressedString(Arr : tCompressedStringArray) : String;ππProcedure CompressString(st : String; Var Arr : tCompressedStringArray;π Var len : Integer);π { converts st into a tCompressedStringArray of length len }ππImplementationππConstπ FreqChar : Array[4..14] of Char = 'etaonirshdl';π { can't be in [0..3] because two empty bits signify a space }πππFunction GetCompressedString(Arr : tCompressedStringArray) : String;πVarπ Shift : Byte;π i : Integer;π ch : Char;π st : String;π b : Byte;ππ Function GetHalfNibble : Byte;π beginπ GetHalfNibble := (Arr[i] shr Shift) and 3;π if Shift = 0 then beginπ Shift := 6;π inc(i);π end else dec(Shift,2);π end;ππbeginπ st := '';π i := 1;π Shift := 6;π Repeatπ b := GetHalfNibble;π if b = 0 thenπ ch := ' 'π else beginπ b := (b shl 2) or GetHalfNibble;π if b = $F then beginπ b := GetHalfNibble shl 6;π b := b or GetHalfNibble shl 4;π b := b or GetHalfNibble shl 2;π b := b or GetHalfNibble;π ch := Char(b);π end elseπ ch := FreqChar[b];π end;π if ch <> #0 then st := st + ch;π Until ch = #0;π GetCompressedString := st;πend;ππProcedure CompressString(st : String; Var Arr : tCompressedStringArray;π Var len : Integer);π{ converts st into a tCompressedStringArray of length len }πVarπ i : Integer;π Shift : Byte;ππ Procedure OutHalfNibble(b : Byte);π beginπ Arr[len] := Arr[len] or (b shl Shift);π if Shift = 0 then beginπ Shift := 6;π inc(len);π end else dec(Shift,2);π end;ππ Procedure OutChar(ch : Char);π Varπ i : Byte;π bych : Byte Absolute ch;π beginπ if ch = ' ' thenπ OutHalfNibble(0)π else beginπ i := 4;π While (i<15) and (FreqChar[i]<>ch) do inc(i);π OutHalfNibble(i shr 2);π OutHalfNibble(i and 3);π if i = $F then beginπ OutHalfNibble(bych shr 6);π OutHalfNibble((bych shr 4) and 3);π OutHalfNibble((bych shr 2) and 3);π OutHalfNibble(bych and 3);π end;π end;π end;ππbeginπ len := 1;π Shift := 6;π fillChar(Arr,sizeof(Arr),0);π For i := 1 to length(st) do OutChar(st[i]);π OutChar(#0); { end of compressed String signaled by #0 }π if Shift = 6π then dec(len);πend;ππend.π 4 05-28-9313:33ALL SWAG SUPPORT TEAM Code for LZH.PAS IMPORT 167 πUnit LZH;ππ {$A+,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V-}ππ(*π * LZHUF.C English version 1.0π * Based on Japanese version 29-NOV-1988π * LZSS coded by Haruhiko OKUMURAπ * Adaptive Huffman Coding coded by Haruyasu YOSHIZAKIπ * Edited and translated to English by Kenji RIKITAKEπ * Translated from C to Turbo Pascal by Douglas Webb 2/18/91π * Update and bug correction of TP version 4/29/91 (Sorry!!)π *)ππ{π This Unit allows the user to commpress data using a combination ofπ LZSS Compression and adaptive Huffman coding, or conversely to deCompressπ data that was previously Compressed by this Unit.ππ There are a number of options as to where the data being Compressed/π deCompressed is coming from/going to.ππ In fact it requires that you pass the "LZHPack" Procedure 2 proceduralπ parameter of Type 'GetProcType' and 'PutProcType' (declared below) whichπ will accept 3 parameters and act in every way like a 'BlockRead'/'BlockWrite'π Procedure call. Your 'GetProcType' Procedure should return the dataπ to be Compressed, and Your 'PutProcType' Procedure should do something withπ the Compressed data (ie., put it in a File). In Case you need to know (andπ you do if you want to deCompress this data again) the number of Bytes in theπ Compressed data (original, not Compressed size) is returned in 'Bytes_Written'.ππ GetBytesProc = Procedure(Var DTA; NBytes:Word; Var Bytes_Got : Word);π π DTA is the start of a memory location where the inFormation returned shouldπ be. NBytes is the number of Bytes requested. The actual number of Bytesπ returned must be passed in Bytes_Got (if there is no more data then 0π should be returned).ππ PutBytesProc = Procedure(Var DTA; NBytes:Word; Var Bytes_Got : Word);ππ As above except instead of asking For data the Procedure is dumping outπ Compressed data, do somthing With it.πππ "LZHUnPack" is basically the same thing in reverse. It requiresπ procedural parameters of Type 'PutProcType'/'GetProcType' whichπ will act as above. 'GetProcType' must retrieve data Compressed usingπ "LZHPack" (above) and feed it to the unpacking routine as requested.π 'PutProcType' must accept the deCompressed data and do somethingπ withit. You must also pass in the original size of the deCompressed data,π failure to do so will have adverse results.πππ Don't Forget that as procedural parameters the 'GetProcType'/'PutProcType'π Procedures must be Compiled in the 'F+' state to avoid a catastrophe.ππππ}ππ{ note: All the large data structures For these routines are allocated whenπ needed from the heap, and deallocated when finished. So when not in useπ memory requirements are minimal. However, this Unit Uses about 34K ofπ heap space, and 400 Bytes of stack when in use. }πππInterfaceππTypeπππ PutBytesProc = Procedure(Var DTA; NBytes : Word; Var Bytes_Put : Word);π GetBytesProc = Procedure(Var DTA; NBytes : Word; Var Bytes_Got : Word);ππππProcedure LZHPack(Var Bytes_Written : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);πππProcedure LZHUnpack(TextSize : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);πππImplementationππConstπ Exit_OK = 0;π Exit_FAILED = 1;ππ { LZSS Parameters }π N = 4096; { Size of String buffer }π F = 60; { Size of look-ahead buffer }π THRESHOLD = 2;π NUL = N; { end of tree's node }ππ { Huffman coding parameters }π N_Char = (256 - THRESHOLD + F);ππ { Character code (:= 0..N_Char-1) }π T = (N_Char * 2 - 1); { Size of table }π R = (T - 1); { root position }ππ { update when cumulative frequency }π { reaches to this value }π MAX_FREQ = $8000;ππ{π * Tables For encoding/decoding upper 6 bits ofπ * sliding dictionary Pointerπ }ππ { encoder table }π p_len : Array[0..63] of Byte =π ($03, $04, $04, $04, $05, $05, $05, $05,π $05, $05, $05, $05, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $08, $08, $08, $08, $08, $08, $08, $08,π $08, $08, $08, $08, $08, $08, $08, $08);ππ p_code : Array[0..63] of Byte =π ($00, $20, $30, $40, $50, $58, $60, $68,π $70, $78, $80, $88, $90, $94, $98, $9C,π $A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,π $C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,π $D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,π $E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,π $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,π $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);ππ { decoder table }π d_code : Array[0..255] of Byte =π ($00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $00, $00,π $01, $01, $01, $01, $01, $01, $01, $01,π $01, $01, $01, $01, $01, $01, $01, $01,π $02, $02, $02, $02, $02, $02, $02, $02,π $02, $02, $02, $02, $02, $02, $02, $02,π $03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $04, $04, $04, $04, $04, $04, $04, $04,π $05, $05, $05, $05, $05, $05, $05, $05,π $06, $06, $06, $06, $06, $06, $06, $06,π $07, $07, $07, $07, $07, $07, $07, $07,π $08, $08, $08, $08, $08, $08, $08, $08,π $09, $09, $09, $09, $09, $09, $09, $09,π $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,π $0B, $0B, $0B, $0B, $0B, $0B, $0B, $0B,π $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D,π $0E, $0E, $0E, $0E, $0F, $0F, $0F, $0F,π $10, $10, $10, $10, $11, $11, $11, $11,π $12, $12, $12, $12, $13, $13, $13, $13,π $14, $14, $14, $14, $15, $15, $15, $15,π $16, $16, $16, $16, $17, $17, $17, $17,π $18, $18, $19, $19, $1A, $1A, $1B, $1B,π $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,π $20, $20, $21, $21, $22, $22, $23, $23,π $24, $24, $25, $25, $26, $26, $27, $27,π $28, $28, $29, $29, $2A, $2A, $2B, $2B,π $2C, $2C, $2D, $2D, $2E, $2E, $2F, $2F,π $30, $31, $32, $33, $34, $35, $36, $37,π $38, $39, $3A, $3B, $3C, $3D, $3E, $3F);ππ d_len : Array[0..255] of Byte =π ($03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $08, $08, $08, $08, $08, $08, $08, $08,π $08, $08, $08, $08, $08, $08, $08, $08);ππ getbuf : Word = 0;π getlen : Byte = 0;π putlen : Byte = 0;π putbuf : Word = 0;π TextSize : LongInt = 0;π codesize : LongInt = 0;π printcount : LongInt = 0;π match_position : Integer = 0;π match_length : Integer = 0;πππTypeπ FreqType = Array[0..T] of Word; π FreqPtr = ^FreqType;π PntrType = Array[0..pred(T + N_Char)] of Integer;π pntrPtr = ^PntrType;π SonType = Array[0..pred(T)] of Integer;π SonPtr = ^SonType;π TextBufType = Array[0..N + F - 2] of Byte;π TBufPtr = ^TextBufType;π WordRay = Array[0..N] of Integer;π WordRayPtr = ^WordRay;π BWordRay = Array[0..N + 256] of Integer;π BWordRayPtr = ^BWordRay;ππVarπ Text_buf : TBufPtr;π lson, dad : WordRayPtr;π rson : BWordRayPtr;π freq : FreqPtr; { cumulative freq table }ππ{π * pointing parent nodes.π * area [T..(T + N_Char - 1)] are Pointers For leavesπ }π prnt : pntrPtr;ππ { pointing children nodes (son[], son[] + 1)}π son : SonPtr;πππ Procedure InitTree; { Initializing tree }π Varπ i : Integer;π beginπ For i := N + 1 to N + 256 doπ rson^[i] := NUL; { root }π For i := 0 to N doπ dad^[i] := NUL; { node }π end;πππ Procedure InsertNode(R : Integer); { Inserting node to the tree }π Varπ tmp, i, p, cmp : Integer;π key : TBufPtr;π c : Word;π beginπ cmp := 1;π key := @Text_buf^[R];π p := succ(N) + key^[0];π rson^[R] := NUL;π lson^[R] := NUL;π match_length := 0;π While match_length < F doπ beginπ if (cmp >= 0) thenπ beginπ if (rson^[p] <> NUL) thenπ p := rson^[p]π elseπ beginπ rson^[p] := R;π dad^[R] := p;π Exit;π end;π endπ elseπ beginπ if (lson^[p] <> NUL) thenπ p := lson^[p]π elseπ beginπ lson^[p] := R;π dad^[R] := p;π Exit;π end;π end;π i := 0;π cmp := 0;π While (i < F) and (cmp = 0) doπ beginπ inc(i);π cmp := key^[i] - Text_buf^[p + i];π end;π if (i > THRESHOLD) thenπ beginπ tmp := pred((R - p) and pred(N));π if (i > match_length) thenπ beginπ match_position := tmp;π match_length := i;π end;π if (match_length < F) and (i = match_length) thenπ beginπ c := tmp;π if (c < match_position) thenπ match_position := c;π end;π end;π end; { While True do }π dad^[R] := dad^[p];π lson^[R] := lson^[p];π rson^[R] := rson^[p];π dad^[lson^[p]] := R;π dad^[rson^[p]] := R;π if (rson^[dad^[p]] = p) thenπ rson^[dad^[p]] := Rπ elseπ lson^[dad^[p]] := R;π dad^[p] := NUL; { remove p }π end;πππ Procedure DeleteNode(p : Integer); { Deleting node from the tree }π Varπ q : Integer;π beginπ if (dad^[p] = NUL) thenπ Exit; { unregistered }π if (rson^[p] = NUL) thenπ q := lson^[p]π else if (lson^[p] = NUL) thenπ q := rson^[p]π elseπ beginπ q := lson^[p];π if (rson^[q] <> NUL) thenπ beginπ Repeatπ q := rson^[q];π Until (rson^[q] = NUL);π rson^[dad^[q]] := lson^[q];π dad^[lson^[q]] := dad^[q];π lson^[q] := lson^[p];π dad^[lson^[p]] := q;π end;π rson^[q] := rson^[p];π dad^[rson^[p]] := q;π end;π dad^[q] := dad^[p];π if (rson^[dad^[p]] = p) thenπ rson^[dad^[p]] := qπ elseπ lson^[dad^[p]] := q;π dad^[p] := NUL;π end;ππ { Huffman coding parameters }ππ Function GetBit(GetBytes : GetBytesProc) : Integer; { get one bit }π Varπ i : Byte;π i2 : Integer;π result : Word;π beginπ While (getlen <= 8) doπ beginπ GetBytes(i, 1, result);π if result = 1 thenπ i2 := iπ else i2 := 0;π getbuf := getbuf or (i2 shl (8 - getlen));π inc(getlen, 8);π end;π i2 := getbuf;π getbuf := getbuf shl 1;π dec(getlen);π GetBit := Integer((i2 < 0));π end;πππ Function GetByte(GetBytes : GetBytesProc) : Integer; { get a Byte }π Varπ j : Byte;π i, result : Word;π beginπ While (getlen <= 8) doπ beginπ GetBytes(j, 1, result);π if result = 1 thenπ i := jπ elseπ i := 0;π getbuf := getbuf or (i shl (8 - getlen));π inc(getlen, 8);π end;π i := getbuf;π getbuf := getbuf shl 8;π dec(getlen, 8);π GetByte := Integer(i shr 8);π end;πππ Procedure Putcode(l : Integer; c : Word;π PutBytes : PutBytesProc); { output c bits }π Varπ Temp : Byte;π Got : Word;π beginπ putbuf := putbuf or (c shr putlen);π inc(putlen, l);π if (putlen >= 8) thenπ beginπ Temp := putbuf shr 8;π PutBytes(Temp, 1, Got);π dec(putlen, 8);π if (putlen >= 8) thenπ beginπ Temp := lo(putbuf);π PutBytes(Temp, 1, Got);π inc(codesize, 2);π dec(putlen, 8);π putbuf := c shl (l - putlen);π endπ elseπ beginπ putbuf := putbuf shl 8;π inc(codesize);π end;π end;π end;πππ { initialize freq tree }ππ Procedure StartHuff;π Varπ i, j : Integer;π beginπ For i := 0 to pred(N_Char) doπ beginπ freq^[i] := 1;π son^[i] := i + T;π prnt^[i + T] := i;π end;π i := 0;π j := N_Char;π While (j <= R) doπ beginπ freq^[j] := freq^[i] + freq^[i + 1];π son^[j] := i;π prnt^[i] := j;π prnt^[i + 1] := j;π inc(i, 2);π inc(j);π end;π freq^[T] := $ffff;π prnt^[R] := 0;π end;πππ { reConstruct freq tree }ππ Procedure reConst;π Varπ i, j, k, tmp : Integer;π F, l : Word;π beginπ { halven cumulative freq For leaf nodes }π j := 0;π For i := 0 to pred(T) doπ beginπ if (son^[i] >= T) thenπ beginπ freq^[j] := succ(freq^[i]) div 2; {@@ Bug Fix MOD -> div @@}π son^[j] := son^[i];π inc(j);π end;π end;π { make a tree : first, connect children nodes }π i := 0;π j := N_Char;π While (j < T) doπ beginπ k := succ(i);π F := freq^[i] + freq^[k];π freq^[j] := F;π k := pred(j);π While F < freq^[k] doπ dec(k);π inc(k);π l := (j - k) shl 1;π tmp := succ(k);π move(freq^[k], freq^[tmp], l);π freq^[k] := F;π move(son^[k], son^[tmp], l);π son^[k] := i;π inc(i, 2);π inc(j);π end;π { connect parent nodes }π For i := 0 to pred(T) doπ beginπ k := son^[i];π if (k >= T) thenπ beginπ prnt^[k] := i;π endπ elseπ beginπ prnt^[k] := i;π prnt^[succ(k)] := i;π end;π end;π end;πππ { update freq tree }ππ Procedure update(c : Integer);π Varπ i, j, k, l : Integer;π beginπ if (freq^[R] = MAX_FREQ) thenπ beginπ reConst;π end;π c := prnt^[c + T];π Repeatπ inc(freq^[c]);π k := freq^[c];π { swap nodes to keep the tree freq-ordered }π l := succ(c);π if (k > freq^[l]) thenπ beginπ While (k > freq^[l]) doπ inc(l);π dec(l);π freq^[c] := freq^[l];π freq^[l] := k;π i := son^[c];π prnt^[i] := l;π if (i < T) then prnt^[succ(i)] := l;π j := son^[l];π son^[l] := i;π prnt^[j] := c;π if (j < T) then prnt^[succ(j)] := c;π son^[c] := j;π c := l;π end;π c := prnt^[c];π Until (c = 0); { Repeat it Until reaching the root }π end;πππVarπ code, len : Word;ππ Procedure EncodeChar(c : Word; PutBytes : PutBytesProc);π Varπ i : Word;π j, k : Integer;π beginπ i := 0;π j := 0;π k := prnt^[c + T];π { search connections from leaf node to the root }π Repeatπ i := i shr 1;π {π if node's address is odd, output 1π else output 0π }π if Boolean(k and 1) then inc(i, $8000);π inc(j);π k := prnt^[k];π Until (k = R);π Putcode(j, i, PutBytes);π code := i;π len := j;π update(c);π end;πππ Procedure EncodePosition(c : Word; PutBytes : PutBytesProc);π Varπ i, j : Word;π beginπ { output upper 6 bits With encoding }π i := c shr 6;π j := p_code[i];π Putcode(p_len[i], j shl 8, PutBytes);π { output lower 6 bits directly }π Putcode(6, (c and $3f) shl 10, PutBytes);π end;πππ Procedure Encodeend(PutBytes : PutBytesProc);π Varπ Temp : Byte;π Got : Word;π beginπ if Boolean(putlen) thenπ beginπ Temp := lo(putbuf shr 8);π PutBytes(Temp, 1, Got);π inc(codesize);π end;π end;πππ Function DecodeChar(GetBytes : GetBytesProc) : Integer;π Varπ c : Word;π beginπ c := son^[R];π {π * start searching tree from the root to leaves.π * choose node #(son[]) if input bit = 0π * else choose #(son[]+1) (input bit = 1)π }π While (c < T) doπ beginπ c := c + GetBit(GetBytes);π c := son^[c];π end;π c := c - T;π update(c);π DecodeChar := Integer(c);π end;πππ Function DecodePosition(GetBytes : GetBytesProc) : Word;π Varπ i, j, c : Word;π beginπ { decode upper 6 bits from given table }π i := GetByte(GetBytes);π c := Word(d_code[i] shl 6);π j := d_len[i];π { input lower 6 bits directly }π dec(j, 2);π While j <> 0 doπ beginπ i := (i shl 1) + GetBit(GetBytes);π dec(j);π end;π DecodePosition := c or i and $3f;π end;πππ { Compression }ππ Procedure InitLZH;π beginπ getbuf := 0;π getlen := 0;π putlen := 0;π putbuf := 0;π TextSize := 0;π codesize := 0;π printcount := 0;π match_position := 0;π match_length := 0;π new(lson);π new(dad);π new(rson);π new(Text_buf);π new(freq);π new(prnt);π new(son);π end;πππ Procedure endLZH;π beginπ dispose(son);π dispose(prnt);π dispose(freq);π dispose(Text_buf);π dispose(rson);π dispose(dad);π dispose(lson);π end;πππ Procedure LZHPack(Var Bytes_Written : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);π Varπ ct : Byte;π i, len, R, s, last_match_length : Integer;π Got : Word;π beginπ InitLZH;π TextSize := 0; { rewind and rescan }π StartHuff;π InitTree;π s := 0;π R := N - F;π fillChar(Text_buf^[0], R, ' ');π len := 0;π Got := 1;π While (len < F) and (Got <> 0) doπ beginπ GetBytes(ct, 1, Got);π if Got <> 0 thenπ beginπ Text_buf^[R + len] := ct;π inc(len);π end;π end;π TextSize := len;π For i := 1 to F doπ InsertNode(R - i);π InsertNode(R);π Repeatπ if (match_length > len) thenπ match_length := len;π if (match_length <= THRESHOLD) thenπ beginπ match_length := 1;π EncodeChar(Text_buf^[R], PutBytes);π endπ elseπ beginπ EncodeChar(255 - THRESHOLD + match_length, PutBytes);π EncodePosition(match_position, PutBytes);π end;π last_match_length := match_length;π i := 0;π Got := 1;π While (i < last_match_length) and (Got <> 0) doπ beginπ GetBytes(ct, 1, Got);π if Got <> 0 thenπ beginπ DeleteNode(s);π Text_buf^[s] := ct;π if (s < pred(F)) thenπ Text_buf^[s + N] := ct;π s := succ(s) and pred(N);π R := succ(R) and pred(N);π InsertNode(R);π inc(i);π end;π end;π inc(TextSize, i);π While (i < last_match_length) doπ beginπ inc(i);π DeleteNode(s);π s := succ(s) and pred(N);π R := succ(R) and pred(N);π dec(len);π if Boolean(len) then InsertNode(R);π end;π Until (len <= 0);π Encodeend(PutBytes);π endLZH;π Bytes_Written := TextSize;π end;πππ Procedure LZHUnpack(TextSize : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);π Varπ c, i, j, k, R : Integer;π c2, a : Byte;π count : LongInt;π Put : Word;π beginπ InitLZH;π StartHuff;π R := N - F;π fillChar(Text_buf^[0], R, ' ');π count := 0;π While count < TextSize doπ beginπ c := DecodeChar(GetBytes);π if (c < 256) thenπ beginπ c2 := lo(c);π PutBytes(c2, 1, Put);π Text_buf^[R] := c;π inc(R);π R := R and pred(N);π inc(count);π endπ elseπ beginπ i := (R - succ(DecodePosition(GetBytes))) and pred(N);π j := c - 255 + THRESHOLD;π For k := 0 to pred(j) doπ beginπ c := Text_buf^[(i + k) and pred(N)];π c2 := lo(c);π PutBytes(c2, 1, Put);π Text_buf^[R] := c;π inc(R);π R := R and pred(N);π inc(count);π end;π end;π end;π endLZH;π end;πππend.ππ 5 05-28-9313:33ALL SWAG SUPPORT TEAM Test for LZH Code IMPORT 22 πProgram LZHTest;πUsesπ LZH;ππConstπ MaxBuf = 4096; { Must be bigger than the biggest chunk being asked For. }ππTypeπ BufType = Array[1..MaxBuf] of Byte;π BufPtr = ^BufType;ππVarπ InBuf, OutBuf : BufPtr;π inFile, OutFile : File;π s : String;π Bytes_Written : LongInt;π Size : LongInt;π Temp : Word;πππ {$F+}π Procedure GetBlock(Var Target; NoBytes : Word; Var Actual_Bytes : Word);π Constπ Posn : Word = 1;π Buf : Word = 0;π Varπ Temp : Word;π beginπ if (Posn > Buf) or (Posn + NoBytes > succ(Buf)) thenπ beginπ if Posn > Buf thenπ beginπ blockread(inFile, InBuf^, MaxBuf, Buf);π Write('+');π endπ elseπ beginπ move(InBuf^[Posn], InBuf^[1], Buf - Posn);π blockread(inFile, InBuf^[Buf - Posn], MaxBuf - (Buf - Posn), Temp);π Buf := Buf - Posn + Temp;π Write('+');π end;π if Buf = 0 thenπ beginπ Actual_Bytes := 0;π Writeln;π Exit;π end;π Posn := 1;π end;π move(InBuf^[Posn], Target, NoBytes);π inc(Posn, NoBytes);π if Posn > succ(Buf) thenπ Actual_Bytes := NoBytes - (Posn - succ(Buf))π else Actual_Bytes := NoBytes;π end;πππ Procedure PutBlock(Var Source; NoBytes : Word; Var Actual_Bytes : Word);π Constπ Posn : Word = 1;π Varπ Temp : Word;π beginπ if NoBytes = 0 then { Flush condition }π beginπ blockWrite(OutFile, OutBuf^, pred(Posn), Temp);π Exit;π end;π if (Posn > MaxBuf) or (Posn + NoBytes > succ(MaxBuf)) thenπ beginπ blockWrite(OutFile, OutBuf^, pred(Posn), Temp);π Posn := 1;π end;π move(Source, OutBuf^[Posn], NoBytes);π inc(Posn, NoBytes);π Actual_Bytes := NoBytes;π end;ππ {$F-}ππbeginπ if (paramcount <> 3) thenπ beginπ Writeln('Usage:lzhuf e(Compression)|d(unCompression) inFile outFile');π halt(1);π end;π s := paramstr(1);π if not(s[1] in ['D', 'E', 'd', 'e']) thenπ halt(1);π assign(inFile, paramstr(2));π reset(inFile, 1);π assign(OutFile, paramstr(3));π reWrite(OutFile, 1);π new(InBuf);π new(OutBuf);π if (upCase(s[1]) = 'E') thenπ beginπ Size := Filesize(inFile);π blockWrite(OutFile, Size, sizeof(LongInt));π LZHPack(Bytes_Written, GetBlock, PutBlock);π PutBlock(Size, 0, Temp);π endπ elseπ beginπ blockread(inFile, Size, sizeof(LongInt));π LZHUnPack(Size, GetBlock, PutBlock);π PutBlock(Size, 0, Temp);π end;π dispose(OutBuf);π dispose(InBuf);π close(inFile);π close(OutFile);πend.ππ 6 05-28-9313:33ALL SWAG SUPPORT TEAM View LZH File IMPORT 33 Program lzhview;ππUsesπ Dos, Crt;ππConstπ BSize = 4096; { I/O Buffer Size }ππType LZHHead = Recordπ HSize : Byte;π Fill1 : Byte;π Method : Array[1..5] of Char;π CompSize : LongInt;π UCompSize : LongInt;π Dos_DT : LongInt;π Fill2 : Word;π FileNameLen: Byte;π FileName : Array[1..12] of Char;π end;ππVar LZH1 : LZHHead;π DT : DateTime;π FSize,L,C : LongInt;π F : File;π BUFF : Array[1..BSize] of Byte;π DATE : String[8]; { formatted date as YY/MM/DD }π TIME : String[6]; { " time as HH:MM }π RES : Word;π DIR : DirStr;π FNAME : NameStr;π EXT : ExtStr;π LZHString,π SName : String;π QUIT : Boolean;π SW : Pointer;ππFunction upper(st:String):String;πVar i : Integer;πbeginπ For i := 1 to length(st) do st[i] :=upcase(st[i]);π upper := st;πend;ππFunction ord_to_str(i:LongInt;j:Byte):String;πVar c:String;πbeginπ str(i,c);π While length(c)<j do c:=' '+c;π ord_to_str:=c;πend;ππProcedure FDT(LI:LongInt); { Format Date/Time (time With AM PM) fields }πVar t_ext : String;πbeginπ UnPackTime (LI,DT);π DATE := ord_to_str(DT.Month,2)+'/'+ord_to_str(DT.Day,2)+'/'π +ord_to_str(DT.Year mod 100,2);π if DATE[1] = ' ' then DATE[1] := '0';π if DATE[4] = ' ' then DATE[4] := '0';π if DATE[7] = ' ' then DATE[7] := '0';π if DT.Hour in [0..11] then t_ext:='a' else t_ext:='p';π if DT.Hour in [13..24] then Dec(DT.Hour,12);π TIME := ord_to_str(DT.Hour,2)+':'+ord_to_str(DT.Min,2);π if TIME[1] = ' ' then TIME[1] := '0';π if TIME[4] = ' ' then TIME[4] := '0';π TIME:=TIME+t_ext;πend; { FDT }ππProcedure GET_LZH_ENTRY;πbeginπ FillChar(LZH1,SizeOf(LZHHead),#0);π FillChar (DT,SizeOf(DT),#0);π L := SizeOf(LZHHead);π Seek (F,C); BlockRead (F,BUFF,L,RES);π Move (BUFF[1],LZH1,L);π With LZH1 doπ if HSize > 0 thenπ beginπ Move (FileNameLen,SNAME,FileNameLen+1);π UnPackTime (Dos_DT,DT);π FSize := CompSizeπ endπ else QUIT := Trueπend; { GET_LZH_ENTRY }ππProcedure DO_LZH (FN : String);πVar fnstr, LZHMeth : String;π fls,totu,totc : LongInt;πbeginπ totu:=0; totc:=0; fls:=0;π Assign (F,FN);π {$I-} Reset (F,1); {$I+}π if Ioresult<>0 thenπ beginπ Writeln(upper(FN)+' not found');π Exit;π end;π FSize := FileSize(F);π C := 0;π QUIT := False;π Writeln('LZH File : '+upper(FN));π Writeln;π Writeln(' Filename OrigSize CompSize Method Date 'π +' Time');π Writeln('------------ -------- -------- -------- --------'π +' ------');π Repeatπ GET_LZH_ENTRY;π if not QUIT thenπ beginπ FSplit (SNAME,DIR,FNAME,EXT);π fnstr:=FNAME+EXT;π While length(fnstr)<12 do insert(' ',fnstr,length(fnstr)+1);π FDT(LZH1.Dos_DT);π inc(totu,lzh1.ucompsize);π inc(totc,lzh1.compsize);π inc(fls,1);π Case LZH1.Method[4] of {normally only 0,1 or 5}π '0' : LZHMeth:='Stored ';π '1' : LZHMeth:='Frozen 1';π '2' : LZHMeth:='Frozen 2';π '3' : LZHMeth:='Frozen 3';π '4' : LZHMeth:='Frozen 4';π '5' : LZHMeth:='Frozen 5';π else LZHMeth:=' Unknown';π end;π LZHString:=Fnstr+' '+ord_to_str(LZH1.UCompsize,8)+' '+π ord_to_str(LZH1.Compsize,8)+' '+lzhmeth+' 'π +DATE+' '+TIME;π Writeln(LZHString);π end;π Inc (C,FSize+LZH1.HSize+2)π Until QUIT;π Close (F);π Writeln('------------ -------- -------- -------- --------'π +' -----');π Writeln(ord_to_str(fls,5)+' Files '+ord_to_str(totu,8)+' 'π +ord_to_str(totc,8));πend; { DO_LZH }ππbeginπ ClrScr;π do_lzh('whatever.lzh'); { <-- place Filename here }πend.ππ{πNote the changes in the date processing and compression method display.πThanks again For the code.π} 7 05-28-9313:33ALL SWAG SUPPORT TEAM Testing for PKLITE File IMPORT 10 {π > Your approach (as all similar ones I have seen so Far) has a majorπ > drawback: you can't use PKLITE, TinYPROG, LZEXE afterwards toπ > squeeze them down in size, as the offsets of the Program change.π > Has anyone come up With a another approach circumventing this?ππYes, you can store it at the end of the .EXE File ( after theπcode ) With the following routine :π}ππFunction CodeLenOnDisk( FName : String ) : LongInt;πVar ImageInfo : Recordπ ExeID : Array[ 0..1 ] of Char;π Remainder : Word;π Size : Wordπ end;π F : File;πbeginπ Assign( F, FName );π Reset( F, 1 );π if Ioresult <> 0 then Exit;π BlockRead( F, ImageInfo, Sizeof( ImageInfo ));π if ImageInfo.ExeID <> 'MZ' then Exit;π CodeLenOnDisk := LongInt( ImageInfo.size-1 )*512 + ImageInfo.Remainder;πend;ππ{πWith this one, you can determine the end of the code in your .EXE File,πand then Write other data there, Drawback : This Dosen't work in networkπenvironments or With shared .EXE Files. I'd recommend an external passWordπFile, and there storing a hash of the passWord.π}π 8 05-28-9313:33ALL SWAG SUPPORT TEAM SHOW ARJ Archive Files IMPORT 15 πProgram ReadArj;πUsesπ Crt,π Search;ππConstπ ArjID = #96#234;ππTypeπ Array10 = Array[1..10] of Byte;π Array12 = Array[1..12] of Char;ππ AFileRec = Recordπ FileDate : LongInt;π CompressedSize : LongInt;π originalSize : LongInt;π DudSpace : Array10;π FileName : Array12π end;ππ Array60K = Array[1..61440] of Byte;ππVarπ Buffer : Array60K;ππ ArjFileRec : AFileRec;ππ ArjFileSize,π ArjRecStart,π ArjRecStop,π Index,π Index1 : LongInt;ππ ArjFile : File;ππbeginπ ClrScr;π fillChar(Buffer, sizeof(Buffer), 0);π fillChar(ArjFileRec, sizeof(ArjFileRec), 0);π ArjFileSize := 0;π ArjRecStart := 1;π ArjRecStop := 0;π assign(ArjFile, 'TEST.ARJ');π {$I-}π reset(ArjFile, 1);π {$I+}π if (ioresult <> 0) thenπ beginπ Writeln(' ERRor OPENinG TEST.ARJ');π halt(255)π end;π ArjFileSize := Filesize(ArjFile);π Index := ArjFileSize - 50;π blockread(ArjFile, Buffer, Index);π close(ArjFile);π Index1 := 50;π ArjFileRec.Filename := ' ';π While ((Index1 + 33) < ArjFileSize) doπ beginπ ArjRecStart := StrPos(Buffer[Index1], Index, ArjID) + 11;π ArjRecStop := StrPos(Buffer[Index1 + ArjRecStart + 22], 13, #0);π move(Buffer[ArjRecStart + Index1], ArjFileRec, (ArjRecStop + 21));π With ArjFileRec doπ beginπ Writeln(' ',FileName, ' Compressed size = ', CompressedSize:6,π ' original size = ', originalSize:6);π FileName := ' ';π inc(Index1, CompressedSize + ArjRecStop + ArjRecStart);π dec(Index, CompressedSize + ArjRecStop + ArjRecStart)π endπ endπend.ππ 9 05-28-9313:33ALL SWAG SUPPORT TEAM Test String Compression IMPORT 24 Program TestComp; { tests Compression }ππ{ kludgy test of Compress Unit }ππUses Crt, Dos, Compress;ππConstπ NumofStrings = 5;ππVarπ ch : Char;π LongestStringLength,i,j,len : Integer;π Textfname,Compfname : String;π TextFile : Text;π ByteFile : File;π CompArr : tCompressedStringArray;π st : Array[1..NumofStrings] of String;π Rec : SearchRec;π BigArr : Array[1..5000] of Byte;π Arr : Array[1..NumofStrings] of tCompressedStringArray;ππbeginπ Writeln('note: No I/O checking in this test.');π Write('Test <C>ompress or <U>nCompress? ');π Repeatπ ch := upCase(ReadKey);π Until ch in ['C','U',#27];π if ch = #27 then halt;π Writeln(ch);π if ch = 'C' then beginπ Writeln('Enter ',NumofStrings,' Strings:');π LongestStringLength := 0;π For i := 1 to NumofStrings do beginπ Write(i,': ');π readln(st[i]);π if length(st[i]) > LongestStringLength thenπ LongestStringLength := length(st[i]);π end;π Writeln;π Writeln('Enter name of File to store unCompressed Strings in.');π Writeln('ANY EXISTinG File With THIS NAME WILL BE OVERWRITTEN.');π readln(Textfname);π assign(TextFile,Textfname);π reWrite(TextFile);π For i := 1 to NumofStrings doπ Writeln(TextFile,st[i]);π close(TextFile);π Writeln;π Writeln('Enter name of File to store Compressed Strings in.');π Writeln('ANY EXISTinG File With THIS NAME WILL BE OVERWRITTEN.');π readln(Compfname);π assign(ByteFile,Compfname);π reWrite(ByteFile,1);π For i := 1 to NumofStrings do beginπ CompressString(st[i],CompArr,len);π blockWrite(ByteFile,CompArr,len);π end;π close(ByteFile);π FindFirst(Textfname,AnyFile,Rec);π Writeln;π Writeln;π Writeln('Size of Text File storing Strings: ',Rec.Size);π Writeln;π Writeln('Using Typed Files, a File of Type String[',π LongestStringLength,π '] would be necessary.');π Writeln('That would be ',π (LongestStringLength+1)*NumofStrings,π ' long, including length Bytes.');π Writeln;π FindFirst(Compfname,AnyFile,Rec);π Writeln('Size of the Compressed File: ',Rec.Size);π Writeln;π Writeln('Now erase the Text File, and run this Program again, choosing');π Writeln('<U>nCompress to show that the Compression retains all info.');π end else begin { ch = 'U' }π Write('Name of Compressed File: ');π readln(Compfname);π assign(ByteFile,Compfname);π reset(ByteFile,1);π blockread(ByteFile,BigArr,Filesize(ByteFile));π close(ByteFile);π For j := 1 to NumofStrings do beginπ i := 1;π While BigArr[i] <> 0 do inc(i);π move(BigArr[1],Arr[j],i);π move(BigArr[i+1],BigArr[1],sizeof(BigArr));π end;π For i := 1 to NumofStrings doπ st[i] := GetCompressedString(Arr[i]);π For i := 1 to NumofStrings doπ Writeln(st[i]);π end;πend.π 10 05-28-9313:33ALL SWAG SUPPORT TEAM ARJ File Viewer IMPORT 53 {πAuthor: Steve WierengaπARJ Viewerπ}π{Hello All:πI am releasing these Units to the public domain. They are Units to view Arj,πLzh, and Zip Files. They are by no means professional, and probably have someπbugs. If you use these in your Programs and feel like giving me credit, Iπwon't Object... Here goes: }ππUnit ArjV;ππ(**) Interface (**)ππUsesπ Dos,Crt;ππTypeπ AFHeader = Record { ArjFileHeader }π HeadID,π HdrSize : Word;π HeadSize,π VerNum,π MinVerNum,π HostOS,π ArjFlag,π Method,π FType,π Reserved : Byte;π FileTime,π PackSize,π OrigSize,π FileCRC : LongInt;π FilePosF,π FileAcc,π HostData : Word;π end;ππVarπ ff : Integer;π b : Byte;π f : File;π sl : LongInt;π NR : Word;π FHdr : ^AFHeader;π s,sss : String;π Method : String[8];π l : String[80];π Z,π totalu,π totalc : LongInt;π x,d : LongInt;π Dt1,dt2: DateTime;π i,e : Integer;π registered : Boolean;ππProcedure ArjView(ArjFile : String);πFunction GAN(ArjFile : String): String;ππ(**) Implementation (**)ππProcedure Terminate;πbeginπ Write('ARCHPEEK could not find specified File.π Aborting...');π Halt;πend;ππProcedure ArjView(ArjFile : String);πbeginπ New(FHdr);π Assign(f, arjFile);π {$I-}π Reset(F, 1); { Open File }π {$I+}π If IOResult <> 0 thenπ Terminate; { Specified File exists?}π registered := False; { Unregistered }π if not registered thenπ beginπ Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');π Delay(200);π end;π SL := 0;z := 0;TotalU := 0; TotalC := 0; { Init Variables }π sss := GAN(ArjFile); { Get the Arj Filename }π Writeln('Arj FileName: ',SSS);π Write(' Name Length Size Saved Method Date Time ');π WriteLn('____________________________________________________________________________');π ff := 0;π Repeatπ ff := ff + 1;π Seek(F,SL);π BlockRead(F,FHdr^,SizeOf(AFHeader),NR); { Read the header }π If (NR = SizeOf(AFHeader)) Thenπ beginπ s := '';π Repeatπ BlockRead(F,B,1); { Get Char For Compressed Filename }π If B <> 0 Thenπ s := s + Chr(b); { Put Char in String }π Until B = 0; { Until no more Chars }π Case Length(S) Of { Straighten out String }π 0 : s := s + ' ';π 1 : S := s + ' ';π 2 : s := s + ' ';π 3 : S := S + ' ';π 4 : S := S + ' ';π 5 : S := S + ' ';π 6 : S := S + ' ';π 7 : S := S + ' ';π 8 : S := S + ' ';π 9 : S := S + ' ';π 10 : S := S + ' ';π 11 : S := S + ' ';π 12 : S := S;π end;π z := z + 1;π UnPackTime(FHdr^.FileTime,dt2); { Get the time of compressed File }π Case FHdr^.Method Of { Get compression method }π 0 : Method := 'Stored ';π 1 : Method := 'Most ';π 2 : Method := '2nd Most';π 3 : Method := '2nd Fast';π 4 : Method := 'Fastest ';π end;π Write( ' ',S,FHdr^.OrigSize:9,FHdr^.PackSize:10);π { Write Filesizes }π If ff > 1 thenπ { Don't get first Arj File in Arj File }π Write( (100-FHdr^.PackSize/FHdr^.OrigSize*100):9:0,'%',Method:15)π { Write ratios, method }π Elseπ Write( Method:25);π Case dt2.month of { Show date of compressed File }π 1..9 : Write( '0':4,dt2.month);π 10..12 : Write( dt2.month:4);π end;π Write( '/');π Case dt2.day ofπ 1..9 : Write( '0',dt2.day);π 10..31 : Write( dt2.day);π end;π Write( '/');π Case dt2.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case dt2.hour of { Show time of compressed File }π 0..9 : Write( '0':2,dt2.hour,':');π 10..23 : Write( dt2.hour:3,':');π end;π Case dt2.min ofπ 0..9 : Write( '0',dt2.min,':');π 10..59 : Write( dt2.min,':');π end;π Case dt2.sec ofπ 0..9 : Writeln( '0',dt2.sec);π 10..59 : Writeln( dt2.sec);π end;π TotalU := TotalU + FHdr^.OrigSize; { Increase total uncompressed size }π TotalC := TotalC + FHdr^.PackSize; { Increase total compressed size }π Repeatπ BlockRead(F,B,1);π Until b = 0;π BlockRead(F,FHdr^.FileCRC,4); { Go past File CRC }π BlockRead(f,NR,2);π Sl := FilePos(F) + FHdr^.PackSize; { Where are we in File? }π end;ππ Until (FHdr^.HdrSize = 0); { No more Files? }π GetFTime(F,x);π UnPackTime(x,dt1);π WriteLn('============================================================================');π Write( (z-1):4,' Files',TotalU:12,TotalC:10,(100-TotalC/TotalU*100):9:0,'%');π Case dt1.month of { Get date and time of Arj File }π 1..9 : Write( '0':19,dt1.month);π 10..12 : Write( dt1.month:20);π end;π Write( '/');π Case dt1.day ofπ 1..9 : Write( '0',dt1.day);π 10..31 : Write( dt1.day);π end;π Write( '/');π Case dt1.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case dt1.hour ofπ 0..9 : Write( '0':2,dt1.hour,':');π 10..23 : Write( dt1.hour:3,':');π end;π Case dt1.min ofπ 0..9 : Write( '0',dt1.min,':');π 10..59 : Write( dt1.min,':');π end;π Case dt1.sec ofπ 0..9 : Writeln( '0',dt1.sec);π 10..59 : Writeln( dt1.sec);π end;π Close(f);π Dispose(FHdr); { Done }πend;ππFunction GAN(ARJFile:String): String;πVarπ Dir : DirStr;π Name : NameStr;π Exts : ExtStr;πbeginπ FSplit(ARJFile,Dir,Name,Exts);π GAN := Name + Exts;πend;ππend.π 11 05-28-9313:33ALL SWAG SUPPORT TEAM LZH File Viewer IMPORT 57 {πAuthor: Steve WierengaπLZH Viewerπ}ππUnit Lzhv;π(**) Interface (**)πUsesπ Dos,Crt;ππTypeπ FileheaderType = Record { Lzh File header }π Headsize,π Headchk : Byte;π HeadID : packed Array[1..5] of Char;π Packsize,π Origsize,π Filetime : LongInt;π Attr : Word;π Filename : String[12];π f32 : PathStr;π dt : DateTime;π end;ππVarπ Fh : FileheaderType;π Fha : Array[1..sizeof(FileheaderType)] of Byte Absolute fh;π crc : Word; { CRC value }π crcbuf : Array[1..2] of Byte Absolute CRC;π crc_table : Array[0..255] of Word; { Table of CRC's }π inFile : File; { File to be processed }π registered : Boolean; { Is registered? }ππProcedure Make_crc_table; { Create table of CRC's }πFunction Mksum : Byte; { Get CheckSum }πProcedure ViewLzh(LZHFile : String); { View the File }πFunction GAN(LZHFile : String) : String; { Get the LZH Filename }πππ(**) Implementation (**)πProcedure Terminate; { Exit the Program }πbeginπ Write('ARCHPEEK could not find specified File. Aborting...');π Halt;πend;ππProcedure Make_crc_table;πVarπ i,π index,π ax : Word;π carry : Boolean;πbeginπ index := 0;π Repeatπ ax := index;π For i := 1 to 8 doπ beginπ carry := odd(ax);π ax := ax shr 1;π if carry thenπ ax := ax xor $A001;π end;π crc_table[index] := ax;π inc(index);π Until index > 255;πend;ππ{ use this to calculate the CRC value of the original File }π{ call this Function afer reading every Byte from the File }πProcedure calccrc(data : Byte);πVarπ index : Integer;πbeginπ crcbuf[1] := crcbuf[1] xor data;π index := crcbuf[1];π crc := crc shr 8;π crc := crc xor crc_table[index];πend;πππFunction Mksum : Byte; {calculate check sum For File header }πVarπ i : Integer;π b : Byte;πbeginπ b := 0;π For i := 3 to fh.headsize+2 doπ b := b+fha[i];π mksum := b;πend;ππProcedure viewlzh(LZHFile : String); { View the LZH File }πVarπ l1,l2,π oldFilepos,π a,b,a1,b1,π totalorig,π totalpack : LongInt;π count,z : Integer;π numread,π i, year1,π month1,π day1,π hour1,π min1,π sec1 : Word;π s1 : String[50];π s2 : String[20];π l : String[80];π sss : String;πbeginπ registered := False; { Unregistered }π if not registered then { Registered? }π beginπ Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');π Delay(200);π end;π assign(inFile,LZHFile);π {$I-}π reset(inFile,1); { Open LZH File }π {$I+}π If IOResult <> 0 thenπ Terminate; { Specified File exists? }π sss := GAN(LZHFile); { Get Filename of LZH File }π Writeln( 'Lzh FileName: ',sss);π WriteLn( ' Name Length Size Saved Date Time ');π WriteLn('__________________________________________________________');π oldFilepos := 0; { Init Variables }π count := 1;π z := 0;π a1 := 0;π Repeatπ z := z + 1;π seek(inFile,oldFilepos); {π Goto start of File}π blockread(inFile,fha,sizeof(FileheaderType),numread); {π Read Fileheader}π oldFilepos := oldFilepos+fh.headsize+2+fh.packsize; {π Where are we? }π i := Mksum; { Get the checksum }π if fh.headsize <> 0 thenπ beginπ if i <> fh.headchk thenπ beginπ Writeln('Error in File. Unable to read. Aborting...');π Close(inFile);π Exit;π end;π Case Length(Fh.FileName) Of { Straigthen out String }π 1 : Fh.FileName := Fh.FileName + ' ';π 2 : Fh.FileName := Fh.FileName + ' ';π 3 : Fh.FileName := Fh.FileName + ' ';π 4 : Fh.FileName := Fh.FileName + ' ';π 5 : Fh.FileName := Fh.FileName + ' ';π 6 : Fh.FileName := Fh.FileName + ' ';π 7 : Fh.FileName := Fh.FileName + ' ';π 8 : Fh.FileName := Fh.FileName + ' ';π 9 : Fh.FileName := Fh.FileName + ' ';π 10 : Fh.FileName := Fh.FileName + ' ';π 11 : Fh.FileName := Fh.FileName + ' ';π 12 : Fh.FileName := Fh.FileName + '';π end;π UnPackTime(Fh.FileTime,Fh.DT);π a1 := a1 + Fh.OrigSize; { Increase Uncompressed Size }π Write(' ', fh.Filename : 2, fh.origsize : 9, fh.packSize : 10,π (100 - fh.packSize / fh.origSize * 100) : 5 : 0, '%');π { Display info }π Case fh.dt.month of { Get date and time }π 1..9 : Write( '0':4,fh.dt.month);π 10..12 : Write( ' ',fh.dt.month:4);π end;π Write( '/');π Case fh.dt.day ofπ 1..9 : Write( '0',fh.dt.day);π 10..31 : Write( fh.dt.day);π end;π Write( '/');π Case fh.dt.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case fh.dt.hour ofπ 0..9 : Write( '0':3,fh.dt.hour,':');π 10..23 : Write( ' ',fh.dt.hour:3,':');π end;π Case fh.dt.min ofπ 0..9 : Write( '0',fh.dt.min,':');π 10..59 : Write( fh.dt.min,':');π end;π Case fh.dt.sec ofπ 0..9 : Writeln( '0',fh.dt.sec);π 10..59 : Writeln( fh.dt.sec);π end;π end;π Until (fh.headsize=0);π Writeln( '===========================================================');π GetFTime(inFile,l1);π UnPackTime(l1,fh.dt);π Write( ' ', z, ' Files ', a1 : 12, FileSize(inFile) : 10,π (100 - FileSize(inFile) / a1 * 100) : 5 : 0, '%');π Case fh.dt.month ofπ 1..9 : Write( '0':4,fh.dt.month);π 10..12 : Write( ' ',fh.dt.month:4);π end;π Write( '/');π Case fh.dt.day ofπ 1..9 : Write( '0',fh.dt.day);π 10..31 : Write( fh.dt.day);π end;π Write( '/');π Case fh.dt.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case fh.dt.hour ofπ 0..9 : Write( '0':3,fh.dt.hour,':');π 10..23 : Write( ' ',fh.dt.hour:3,':');π end;π Case fh.dt.min ofπ 0..9 : Write( '0',fh.dt.min,':');π 10..59 : Write( fh.dt.min,':');π end;π Case fh.dt.sec ofπ 0..9 : Writeln( '0',fh.dt.sec);π 10..59 : Writeln( fh.dt.sec);π end;πend;ππFunction GAN(LZHFile : String): String;πVarπ Dir : DirStr;π Name : NameStr;π Exts : ExtStr;πbeginπ FSplit(LZHFile,Dir,Name,Exts);π GAN := Name + Exts;πend;πππend.ππ 12 05-28-9313:33ALL SWAG SUPPORT TEAM Zip File Viewer IMPORT 36 {πAuthor: Steve WierengaπZIP Viewerπ}ππUnit ZipV;ππ(**) Interface (**)ππUsesπ Dos,Crt;πProcedure ZipView(ZIPFile:String);πFunction GAN(ZIPFile : String) : String;ππ(**) Implementation (**)ππProcedure Terminate;πbeginπ Write('ARCHPEEK could not find specified File. Aborting...');π Halt;πend;ππProcedure ZipView(ZIPFile : String); { View the ZIP File }πConstπ SIG = $04034B50; { Signature }πTypeπ ZFHeader = Record { Zip File Header }π Signature : LongInt;π Version,π GPBFlag,π Compress,π Date,Time : Word;π CRC32,π CSize,π USize : LongInt;π FNameLen,π ExtraField : Word;π end;ππVarπ z : Integer;π x,π totalu,π totalc : LongInt;π Hdr : ^ZFHeader;π F : File;π S,sss : String;π own : Text;π dt1 : DateTime;π l : String[80];π registered : Boolean; { Is registered? }ππConstπ CompTypes : Array[0..7] of String[9] =π ('Stored ','Shrunk ','Reduced1','Reduced2','Reduced3',π 'Reduced4','Imploded ','Deflated');π { Method used to compress }π r = #196;π q = #205;ππbeginπ z := 0; totalu := 0; totalc := 0; { Init Variables }π registered := False; { Unregistered }π if not registered then { Is registered? }π beginπ Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');π Delay(200);π end;π New(Hdr);π Assign(F,ZIPFile);π {$I-}π Reset(F,1); { Open File }π {$I+}π If IOResult <> 0 then Terminate; { Couldn't open Zip File }π sss := GAN(ZipFile); { Get the Zip Filename }π Writeln('Zip FileName: ',sss);π WriteLn( ' Name Length Size Saved Method');π WriteLn(r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,π r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r);π Repeatπ FillChar(S,SizeOf(S), #0); { Pad With nulls }π BlockRead(F,Hdr^,SizeOf(ZFHeader));π { Read File Header }π BlockRead(F,Mem[Seg(S) : Ofs(S) + 1], Hdr^.FNameLen);π s[0] := Chr(Hdr^.FNameLen);π Case Length(S) Of { Straighten String }π 0 : s := s + ' ';π 1 : S := s + ' ';π 2 : s := s + ' ';π 3 : S := S + ' ';π 4 : S := S + ' ';π 5 : S := S + ' ';π 6 : S := S + ' ';π 7 : S := S + ' ';π 8 : S := S + ' ';π 9 : S := S + ' ';π 10 : S := S + ' ';π 11 : S := S + ' ';π 12 : S := S;π end;π If (Hdr^.Signature = Sig) Then { Is a header }π beginπ z := z + 1;π WriteLn(S,Hdr^.USize:9,Hdr^.CSize:10,(100-Hdr^.CSize/Hdr^.USize*100):5:0,'%',π CompTypes[Hdr^.Compress]:16);π Inc(TotalU,Hdr^.USize); { Increment size uncompressed }π Inc(TotalC,Hdr^.CSize); { Increment size compressed }π end;π Seek(F,FilePos(F) + Hdr^.CSize + Hdr^.ExtraField);π Until Hdr^.Signature <> SIG; { No more Files }π GetFTime(F,x);π UnPackTime(x,DT1);π WriteLn(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,π q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q);π Write( z:4,' Files ',TotalU:12,TotalC:10,(100-TotalC/TotalU*100):5:0,'%');π Case dt1.month of { Get Zip File date and time }π 1..9 : Write( '0':4,dt1.month);π 10..12 : Write( dt1.month:4);π end;π Write( '/');π Case dt1.day ofπ 1..9 : Write( '0',dt1.day);π 10..31 : Write( dt1.day);π end;π Write( '/');π Case dt1.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case dt1.hour ofπ 0..9 : Write( '0':3,dt1.hour,':');π 10..23 : Write( dt1.hour:3,':');π end;π Case dt1.min ofπ 0..9 : Write( '0',dt1.min,':');π 10..59 : Write( dt1.min,':');π end;π Case dt1.sec ofπ 0..9 : Writeln( '0',dt1.sec);π 10..59 : Writeln( dt1.sec);π end;π Close(F);π Dispose(Hdr);πend;πππFunction GAN(ZIPFile:String): String;πVarπ Dir : DirStr;π Name : NameStr;π Exts : ExtStr;πbeginπ FSplit(ZIPFile,Dir,Name,Exts);π GAN := Name + Exts;πend;ππend.π
